home *** CD-ROM | disk | FTP | other *** search
/ SuperHack / SuperHack CD.bin / CODING / VBASIC / ICONXT.ZIP / ICONXTRC.FRM (.txt) next >
Encoding:
Visual Basic Form  |  1995-12-06  |  5.0 KB  |  121 lines
  1. VERSION 4.00
  2. Begin VB.Form IconXTract 
  3.    Caption         =   "IconXTract"
  4.    ClientHeight    =   2220
  5.    ClientLeft      =   3744
  6.    ClientTop       =   1920
  7.    ClientWidth     =   2100
  8.    Height          =   2544
  9.    Left            =   3696
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   2220
  12.    ScaleWidth      =   2100
  13.    Top             =   1644
  14.    Width           =   2196
  15.    Begin VB.CommandButton Command1 
  16.       Caption         =   "Show Small Icon"
  17.       Height          =   300
  18.       Left            =   312
  19.       TabIndex        =   2
  20.       Top             =   204
  21.       Width           =   1476
  22.    End
  23.    Begin VB.PictureBox Picture1 
  24.       Height          =   732
  25.       Left            =   696
  26.       ScaleHeight     =   684
  27.       ScaleWidth      =   720
  28.       TabIndex        =   1
  29.       Top             =   1128
  30.       Width           =   768
  31.    End
  32.    Begin VB.CommandButton Command2 
  33.       Caption         =   "Show Large Icon"
  34.       Height          =   300
  35.       Left            =   300
  36.       TabIndex        =   0
  37.       Top             =   660
  38.       Width           =   1476
  39.    End
  40. Attribute VB_Name = "IconXTract"
  41. Attribute VB_Creatable = False
  42. Attribute VB_Exposed = False
  43. 'Sample VB4/32-bit code to retrieve the regular (32x32) and
  44. 'small (16x16) icons from an .EXE file without starting the program.
  45. 'Extraction techniques using ExtractIcon only return the 32x32 icon.
  46. 'Note: If the .EXE does not include a small icon, the regular icon will be
  47. 'produced reduced to 16x16, making the function appear to have worked.
  48. 'This sample is hard-coded to look at Explorer.exe, which does have both
  49. 'icons.
  50. 'Developed by Don Bradner with the assistance of Karl Peterson when a
  51. 'particularly nasty GPF wouldn't go away.  Feedback welcome to the Visual
  52. 'Basic Programmer's Journal forum on Compuserve (GO VBPJFORUM), in the
  53. '32-bit section.
  54. Option Explicit
  55. Private Const MAX_PATH = 260
  56. Private Const SHGFI_ICON = &H100
  57. Private Const SHGFI_SYSICONINDEX = &H4000                '  get system icon index
  58. Private Const SHGFI_LARGEICON = &H0                      '  get large icon
  59. Private Const SHGFI_SMALLICON = &H1                      '  get small icon
  60. Private Const ILD_TRANSPARENT = &H1
  61. Private Type SHFILEINFO 'Structure used by SHGetFileInfo
  62.    hIcon As Long
  63.    iIcon As Long
  64.    dwAttributes As Long
  65.    szDisplayName As String * MAX_PATH
  66.    szTypeName As String * 80
  67. End Type
  68. Private Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" (ByVal pszPath As String, ByVal dwFileAttributes As Long, psfi As SHFILEINFO, ByVal cbFileInfo As Long, ByVal uFlags As Long) As Long
  69. Private Declare Function ImageList_Draw Lib "comctl32.dll" (ByVal himl&, ByVal i&, ByVal hDCDest&, ByVal x&, ByVal y&, ByVal flags&) As Long
  70. Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
  71. Private shinfo As SHFILEINFO
  72. Private WinPath As String
  73. Private xPixels As Integer
  74. Private yPixels As Integer
  75. Private Sub Command1_Click()
  76.    Dim himl As Long
  77.    Dim lpzxExeName As String '.EXE file name to get icon from
  78.    Dim nRet As Long
  79.    Dim picLeft As Long
  80.    Dim picTop As Long
  81.    lpzxExeName = WinPath & "\explorer.exe" 'Use any other executable that might contain a small icon
  82.    himl = SHGetFileInfo(lpzxExeName, 0&, shinfo, Len(shinfo), SHGFI_SYSICONINDEX Or SHGFI_SMALLICON)
  83.    '----------------------------------------------------
  84.    'set the picture box up to receive the icon, centered
  85.    '----------------------------------------------------
  86.    picLeft = (Picture1.ScaleWidth / xPixels) / 2 - 8
  87.    picTop = (Picture1.ScaleHeight / yPixels) / 2 - 8
  88.    Picture1.Picture = LoadPicture() 'Clear any existing image
  89.    Picture1.AutoRedraw = True
  90.    nRet = ImageList_Draw(himl, shinfo.iIcon, Picture1.hDC, picLeft, picTop, ILD_TRANSPARENT)
  91.    Picture1.Refresh
  92. End Sub
  93. Private Sub Command2_Click()
  94.    Dim himl As Long
  95.    Dim lpzxExeName As String '.EXE file name to get icon from
  96.    Dim nRet As Long
  97.    Dim picLeft As Long
  98.    Dim picTop As Long
  99.    lpzxExeName = WinPath & "\explorer.exe"
  100.    himl = SHGetFileInfo(lpzxExeName, 0&, shinfo, Len(shinfo), SHGFI_SYSICONINDEX Or SHGFI_LARGEICON)
  101.      
  102.    '----------------------------------------------------
  103.    'set the picture box up to receive the icon, centered
  104.    '----------------------------------------------------
  105.    picLeft = (Picture1.ScaleWidth / xPixels) / 2 - 16
  106.    picTop = (Picture1.ScaleHeight / yPixels) / 2 - 16
  107.    Picture1.Picture = LoadPicture()
  108.    Picture1.AutoRedraw = True
  109.    nRet = ImageList_Draw(himl, shinfo.iIcon, Picture1.hDC, picLeft, picTop, ILD_TRANSPARENT)
  110.    Picture1.Refresh
  111. End Sub
  112. Private Sub Form_Load()
  113.    Dim Buffer As String
  114.    Dim nRet As Long
  115.    Buffer = Space(MAX_PATH)
  116.    nRet = GetWindowsDirectory(Buffer, Len(Buffer))
  117.    WinPath = Left(Buffer, nRet)
  118.    xPixels = Screen.TwipsPerPixelX
  119.    yPixels = Screen.TwipsPerPixelY
  120. End Sub
  121.